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COPYRIGHT (c) 1978, 1980, 1982, 1984 BY 
DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS. 
ALL RIGHTS RESERVED. 


THIS SOFTWARE 4, cite UNDER A LICENSE AND MAY BE i AND face 
ONLY IN ACCORDANCE WITH THE TERMS OF SUCH biCeee AND WITH THE 
INCLUSION OF THe ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER 


2 
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* 
SON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY * 
TRANSFERRED. * 
® 
THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE * 
® 
® 
® 
* 
® 
® 
* 
® 


AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT 
CORPORATION. 


DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS 
SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. 
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++ 
; FACILITY: BASIC code support 
; ABSTRACT: 


This module finds the inverse of a source matrix and stores the inverse 
in the destination matrix (which may be the same as the source matrix). 
As a side result of the inversion, this routine also calculates the 
determinant of the source matrix and stores that result in the OWN 
storage in the BASSDET module. 


; ENVIRONMENT: User Mode, AST Reentrant 


; MODIFIED BY: 
:++ 


1-001 - 
1- - Fix scaling. RW 6-Dec-79 
003 - Change shared external references to G* RNH 25-Sep-81 
- Add support for byte, g & h floating. PLL 29-Sep-81 
- Substitute a macro for the calls to the array_fetch and store 
: routines. This should speed things up. PLL 33-Nov-81 
; 1-006 - Change a MOVL to MOV‘array y-dtype 
: - BLT YSnJo comp) yentine tests Tn FETCH and STORE to run-time tests. 


Original 
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PUPP EB Be Be ES EE EE AANA NAIA POPININONPONINNDY 2 PP OO Os 


> AUTHOR: R. Will, CREATION DATE: 28-Aug-79 


7 = Don't ise — ie, expansions. Pi 16-Mar-82 
8 - Fix g, h floating. PLL 13-Apr- 


1 
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608 28 3 1-008 - Fix hfloat probies in subroutine. PLL 15-Apr-82 
00 9 ; 1-010 = Remove FETCH and STORE macros; hex are now found in macro 

000 60 ; Library MATRIXMAC.OLB. LB 19-May-82 

0000 61 ; 1-011 © Saag local storage to stack storage. cht 9-Jul-1982 

0000 6¢ ; I=hi6 - Use G* for ALL externals. SBL 16-Nov-198 

0000 65 ; 1-015 = fix call to MTHSDINT_R4 - ys put parameter in RO prior 

pees 64 ; to calling. MDL 28-Mar-1983 : : 

000 65 ; 1-014 = scale before calling BASSSSTORE_DET_G&H- this is a coordinated 
464 66 3 change with BASSDET to get G&H_floafting to work. MDL 7-Mar-1984 
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8 $8 -SBTTL DECLARATIONS 
44 71 ; INCLUDE FILES: 
| 00098 
| 000 74 SOSCDEF ; define descriptor offsets 
000 75 SSF DEF ; use to get scale 
| 8 
$900 78 ; EXTERNAL DECLARATIONS: 
| B33 
| $600 3 -DSABL GBL ; Prevent undeclared 
0000 Bg 3; symbols from er 
0000 8 ; automatically gig al. 
0000 84 -EXTRN BASSK_ARGDONMAT ; signalled if all 3 blocks 
0000 85 ; not present in array desc 
0000 86 -EXTRN BASSK_DATTYPERR i; signalled if dtype of arra 
0000 87 ; isn't word long float double 
0000 88 -EXTRN BASSK_MATDIMERR ; signalled if dimct on any 
0000 89 ; array isn't 2 , 
0000 90 ~-EXTRN BASSK_CANINVMAT 5 signal Led if largest remaining 
0000 91 ; element in errey is 0, array 
0000 4 ; appears to be singular 
0000 9 -EXTRN BASSK_ARRMUSSQU ; signalled if input array 
0000 94 ; was not square 
0000 95 -EXTRN BAS$STO_FA_B_R8 ; array element store for byte 
0000 96 -EXTRN BASSSTO_FA_W_R8 3; array element store for word 
0000 97 -EXTRN BASS$STG_FA_L_R8 ; array element store for long 
0000 98 -EXTRN BASSSTO_FA_F_R8 3; array element store - float 
0000 99 -EXTRN BASSSTO_FA_D_R8 ; array e'ement store - double 
0000 100 -EXTRN BASSSTO_FA_G_R8 3; array element store - gfloat 
0000 101 -EXTRN BASS$STO_FA_H_R8 ; array element store - hfloat 
0000 19 -EXTRN BASSFET_FA_B_R8 ; array element fetch - byte 
0000 10 -EXTRN BASSFET_FA_W_R8 3; array element fetch - word 
0000 104 -EXTRN BASSFET_FA_L_R8B ; array element fetch = Long 
0000 105 -EXTRN BASSFET_FA_F_R8 ; array element fetch - float 
0000 106 -EXTRN BASSFET_FA_D_R8 ; array element fetch - double 
0000 107 -EXTRN BASSFET_FA_G_RB ; array element fetch - gfloat 
0000 108 -EXTRN BASSFET_FA_H_RS ; array element fetch - hfloat — 
0000 109 -EXTRN BASSMAT_ASSIGN 3 copy input matrix to destination 
0000 110 ; matrix for in place inversion 
0000 111 ; will also redim dest mat 
444 11 -EXTRN BASSSSCALE_R1 ; scale for double procision 
000 11 ~-EXTRN BASSSSTORE_DET ; store dbl determinant 
0000 114 -EXTRN BASSSSTORE_DET_G ; store gfloat determinant 
0000 115 ~-EXTRN BASSSSTORE DET_H ; store hfloat determinant 
000 116 -EXTRN MTHSDINT RS i routine to integerize double 
000 11 -EXTRN BASSSSTOP 3 signal fatal errors 
000 118 -EXTRN BASSFETCH_BFA 
44 119 -EXTRN BASSSTORE_BFA 
00 120 
0000 121; 
000 «(1 g ; MACROS: 
000 194° 
000 125; SBASSMAT_INV inverse algorithm, see next page 
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ix invert 
BECLA 


—3 
oe 
ae 
“on 


stack 


0000007C 
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s# 
3 Stack 
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FETCH 
STORE 


: EQUATED SYMBOLS: 


offsets 


o 
Cc 
3 
5 
o 
=) 
ce 

nun 


pivi = 16 
pivj = 20 
pivot = 24 
scale = 40 
determinant 


value_desc = 


str_len = 64 
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n array element (found in macro Library 
XMAC.OLB 
an onlay element (found in macro Library 


S 
S 
h 
I 
e 
IXMAC. 


5 
6 
fetc 
MATR 
stor 
MATR 


upper bound of subs 
Loop counter i 
oe counter 
look counter 
row of max remaining elem 
col of max remaining elem 
abs of max remaining elem 

(this aay be hfloat) 
scale (1-10**6) for double 
compute determinant 

(this may be hfloat) 
output descriptor 
Length field within desc 
data type field within desc 
class field within desc 
data (4 longwords worth) 
pointer field within desc 
value of R(K) 
another name for same storage 
yet another name for same 
value of R(I) 
value of C(1) 
output_matrix(R(K), C(1)) 
another name for same storage 
address for addressing c vector 
address for addressing r vector 
address for addressing tag vect 
address for addressing loc vector 
first element of c vector 
first element of r vector 
first element of tag vector 
first element of loc vector 


—coe lt 


= 48 
64 


oo 
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ate te 
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00 CO 
coco 
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foo 


mr 
osx 


subroutine 


temp_pivi = 0 cell to store new pivot row 
temp_pivj = 4 cell to store new pivot col 
temp_pivot = 8 cell to calculate new pivot 


temp_pivot_abs = 24 
saverresull = 40 


absolute value of new pivot 
temp area to store a result 


ee 
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This macro contains the algorithm for inverting array. The inversion 
3} orithm_used is from the COLLECTED ALGORITHMS FROM CACM, algorithms 
and 231. It inverts a matrix in place using the Gauss_Jordan method with 


complete matrix pivoting. It contain the lo 
types and scaling. A macro is used to make 


code for all the different data types. 


»MACRO SBASSMAT_INVERT array_dtype 


dtype': 
OV'arra dtipee™ 


IF N array_dtype, D 
AULD? scale(SP), determinant (SP) 
CLR'array_dtype' ivot (SP) 
MOVE #TS RAO P 
1$: MOVL #1, R11 
2$: MOVL R9, RO 
MOVL R10, R1 
MOVL R11, R 
Sit'erreneeeee One 
arra e 
ta aioe | 
MNEG array_dtype’ RO, RO 
3$: CMP’ array_dtype' RO, pivot (SP) 
Boye ote ‘ RO # t (SP) 
arra e » pivo 
MOVL RTO, pivi (SP) “ 
MOVL R11, pivj (SP) 
4$ INCL R11 


CMPL Soe tent OP? ATT 


2$ 
7$: ACBL maximum_sub(SP), #1, R10, 1$ 


MOVL 


» RI 
MOVL pivj (SP), R2 
F array _dtype' 


MOV’ array_dtype’ RO, pivot (SP) 


ic for all the data 
t easy to maintain the parallel 


: inversion algorithm 


#1, determinant (SP) ; initialize det 


: if double 
; scale it, no integerize needed 


set pivot to 0 

lLowerbound for outer loop 
lLowerbound for inner loop 

pointer to output array 

current row 

current col 

; fetch data from output array 

; see if need ABS 

; positive, no ABS needed 

; negative, negate 
could get performance improv 
for f and d if divided on 
data ayeee and used BIC 

see if larger than pivot 

not barge. go to next element 

new initial pivot 

new pivot row 

new pivot column 

3 next element 

:\replaced AOBLEQ instruction 

3 due to Branch destination 

:/out of range errors | 

3 mext element (AOBLEQ will not 

; work here) 


34 
; Now get the initial pivot without the absolute value. 


3 pointer to output array 
; current row 

; current col 

; fetch data from output array 
: initial pivot 


+ 
; The initial pivot element and it's position are now stored on the 
66 3 stack. perform the inversion algorithm, 


ee 
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| 6 
3 $3 MOVL #1, current_i(SP) :; initialize I loop 
| 0 370 LOOP_I_*array.dtypé" 
| 8 q :+ 
| 009 6 ; Make remaining element with greatest magnitude the next pivot element. 
0 74 ; Keep track in permutation vectors. 
B33 
000 rs INDEX current_i(SP), #1, maximum_sub(SP), #4, #0, RO; ith element 
00 8 chee giv itsry, current_i(SP) 3 any row swapping? 
3; no 
$00 80 MNEG‘arra oGtype’ determinant(SP), determinant(SP) ; change sign of de 
0000 81 5$ NDEX pivi(SP), #1, maximum _sub(SP), #4, #0, RI; pivith element 
0000 Be OVL  r_sub_ CSP rERtI, r_sub_i(SP) ; temp <- R(PIVI), new RCI) 
0000 8 MOVL r_sub_0O(SP)CROJ, r_sub_0(SP)CR1) ; R(PIVI) <= RCI) 
0000 84 OVL rosub_i(SP), r_sub 0(SP) CROJ 3; RCI) <= temp 
44 HH CMPL pivj (SP), current_7(SP) 3 any column swapping? 
3 no 
0000 87 ot ald PAT 3 determinant(SP), determinant(SP) ; change sign of de 
0000 288 6$: N pivj(SP), #1, maximum sub(SP), #4, #0, R2 ; pivjth element 
0000 389 MOVL c..sub_0¢$P) R21, ¢_sub_i(SP ; temp <- C(PIVJ), new C(I) 
0000 90 MOVL c_sub_O(SP)CROJ, c_sub_0(SP)CR2J 3 COPIVJ) <= CCI) 
0000 291 MOVL c_sub_i(SP), c_sub_0(SP)CROJ 3; CCl) <= temp 
0000 $98 :+ 
0000 94 : If pivot element is 0, then array appears to be singular 
0000 396° 
0000 97 Sy erry dtype' pivot (SP) : is pivot 0? 
0000 98 BNEQ 0$ 3; no, continue 
0000 99 JMP ERR_CANINYMAT 3 yes, error 
0000 301: 
0000 8 : Calculate determinant. 
0000 03 ; Switch sign of determinant if \?2?727272227272222227272727\ 
8333 Bs 
448 38 10$: MUL‘ array_dtype'2 pivot(SP), determinant(SP) ; det = det * PIVOT 
0000 08 IF IDN array_dtype, D 
0000 09 DIVD2 scale(S$P), determinant (SP) 3 get rid of extra scale on det 
000 10 CMPD scale(SP), #1 : is the scale factor 0 (10**0) 
B08 11 BEQL 1 : yes, don't integer ize 
0 ¢ MOVD determinant(SP), RO 3 no, integerize det 
000 1 JSB G*MTHSDINT_R 
000 14 MOVD RO, determinant (SP) ; and store the result 
000 15 -ENDC 
000319 z+ 
O60 18 + Now store 1 in ACR(1), C(1)) and divide each element of the row 
09 19 : by the old value of ACR(I), C(I)), ie PIVOT. 
. 7 
3 § 11$: IF IDN array_dtype, H 
88 MOVH #1, RO : 
00 4 MOVL R9, R4 ; pointer to output array 
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ix invert 


20$: 


3¢ 
3 Now store the quotient in A(R(I), C(J)) 


25$: 


Se 
15-SEP-1984 44:44 
Paes ety 7 5 29:37 
MOVL r_sub_i(SP), R5 
MOVL c sub_i(SP), R6 
MOVH RO, data(SPS 
oieee H 
IF IDN array_dtype, G 
MOVG #i, Rg 
MOVL R9, R 
MOVL  _sub_i(SP), R3 
MOVL c_sub_i(SP), R4 
MOVG RO, data(SPs 
ie 8 
IF ION array_dtype, D 
MOV array_dtype' » RO 
MULD2 scale(SP), RO 
MOVL R9, R2 
MOVL r_sub_i(SP), R3 
MOVL —_clsub_i(SP), R4 
MOV array_dtype' 
STORE array_dtype' 


o1FF 
Bey, orray ety e' #1, RO 
MOVL 
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; current row 
3; current col 


ro 


; pointer to output array 
3; current row 
; current col 


; data to be stored 
3; scale the 1 
3; pointer to output array 
3 current row 
3; current col 


RO, data(SP) 


; store data into output array 


; data to be stored 

3; pointer to output array 
3 current row 

3 current col 


; store data into output array 


3; max value for J (row) loop 
3; pointer to output array 
3; current row 
#4, #0, R11; to fetch C(J) 
3; current column 
3; fetch data from output array 


; Prescale the element 


RO 
€(J)) <= ACRCT).CQ)) 7 ACRCL).CUL)) 


; is the scale factor 0 (10**0) 


MOVL r_sub_i(SP), Re 

MOVL  c _sub-i(SP), R 

MOV’ array_dtype' RO, data(SP) 

STORE array_dtype’ 

-ENDC 

-ENDC 

eENDC 

MOVL maximum _sub(SP), R10 

MOVL RY, 

MOVL r_sub_i(SP), R1 

INDEX - #1, maximum_sub(SP), 

MOVL c_sub_O(SP)CR11], R2 

FETCH ‘array_dtype' 

oe IDN grrax_dtype. D 

MULD2 scale(SP), R 

-ENDC 

DIV’ array_dtype'2 ivot( 
seule 3 ACR( 

oe IDN array_dtype. D 

cee ale(SP), # 


EQL 
JSB_- G4MTHSDINT_R4 
-ENDC 


If 1DN 


‘ array_dtype, H 
HOVL «=—-R9, RG athe 


; yes, don't integerize 
; no, integerize 


; pointer to output array 
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MOVL r_sub_i(SP), R5 ; current row 

MOVL c~sub-0(SP)(R11], R6 ; current col 

MOVH RO, data(SP) 

signe H 

at IDN array_dtype, G 

MOVL R9, R2 3; pointer to output array 

MOVL r_sub_i(SP), R3 3 current row 

MOVL C sub-0(SP) (R11), R4 3; current col 

MOVG RO, data(SP) 

SY 8 

olf IDN array_dtype, D 

MOVL R9, R2 ; pointer to output array 

MOVL r_sub_i(s R3 3; current row 

MOVL ¢7sub-0(SP)(R11), R4 3; current col 

MOV array _dtype' RO, data(SP) 

dt array_dtype’ 3; store data into output array 

MOVL R9, RI 3; pointer to output array 

MOVL r_sub_i(SP), R2 ; current row 

MOVL ¢7sub-0(SP)ER11), R3 3; current col 

MOV" array_dtype’ RO, data(SP) 

oe array_dtype’ 3; store data into output array 

-ENDC 

-ENDC 


+ 
Loop through all elements of that row 
(note that SOBGTR will not work here) 


3 next element in row 


3+ 

: Now loop through all elements of the array except the pivot, continuing to 
3 compute inverse. In the area of the array beyond the row and column of the 
3 pivot find the largest element to select the next pivot. 


26$: MOVL SP, R11 ; point to arg list for subr 


IAAP IPOPIPOPINIPOPINIDD 2 9 9 OS DOOOOOOOCOOOOOOOOOOONSO 


NANA 
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SUBL3 #1, current_i(SP), R10 5 upper bound or K loop 
BEQL 30§ : 1 is 1, start with 2 
MOVL #1, current_k(SP) : initialize K loop 
BSBW LOOP_k "array dtype | 3 boop K = 1, I-1 
30$: CMPL current_i(SP)> maximum_sub(SP) ; is I u perbound? 
QL 40$ : yes, finished | loop 


BE 
ADDLS #1, current tor), current b (SP? initialize K loo 


MOVL max imum_subTSP), 


BSBW LOOP_K_‘array_dtype’ ; loop K = I+1, N 
MOVL R2, pivi(SP) 3 new pivot row 
MOVL R35, piv] (SP) : 3; new pivot column 
MOV array_dtype R4, pivot (SP) 3; new pivot element 


; upperbound for K loop | 
; pointer to arg List still set 


PERE RRR ERR PREP PEE RELL ELLE ELLE PPLE LEE PWN 


ooo 
Coooocoo 


—_———___—_ 
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1-014 BECLARAT IONS g-sEp-1 984 19:39:49 UBASRTL. SRCIBASMATINV.MAR; 1 ° (3) 
| 439 ;+ 
09 e79 ; Continue outer (1) loop 
442 ° 
$00 18 ADDL2 #1, current_i(SP) 3 get next I 
4 444 BRW LOOP_I_'array_dtype' ; continue loop, loop escape is 
00 445 : inside loop 
000 4c? 
i +¢8 ; Now store the determinant. The determinant is stored in double precision 
00 449 ; unless the matrix is 9 or h floating. In these cases, the determinant will 
4 $39 3; be stored in g and h floating, respectively. 
000 482 
0900 38 40$: off IDN array_dtype, H 
000 455 CVTDH =scale(SP), temp > cvt scale factor to H_float 
4 +28 MULH2 temp, determinant (SP) ; scale it 
$009 458 PUSHAH determinant (SP) + pass det by ref (stored as h) 
444 223 cms #1, G*BASSS$STORE_DET_H ; store the hfloat det 
9009 461 LIF IDN array_dtype, G 
0000 168 CVTDH = scale(SP), tem > ¢vt_scale factor to G_float 
0000 464 CVTH temp. scale(SP) | ; in 2 steps because no CVTDG 
$44 rt MULG scale(SP), determinant (SP) : scale it 
0000 46 PUSHAG determinant (SP) ; pass det by ref (stored as g) 
0000 468 CALLS #1, G*BASSSSTORE_DET_G ; store the gfloat det 
ay se 
0000 471 IF DIF array_dtype, D : if not double 
0000 ore CVT’ array_dtype'D determinant(SP), determinant(SP) ; make double 
0000 47 MULD2 scale (SP), determinant (SP) ; scale 
0000 474 PUSHAD determinant (SP) 3 pass det by ref (stored as d) 
0000 475 CALLS #1, G*BASSSSTORE_DET 3; store the dbl det 
a ae 
0000 478 PUSHAD determinant (SP) 3; pass det by ref (stored as d) 
0000 479 CALLS #1, G*BASSSSTORE_DET ; store the dbl det 
000 281 “ENDE : 
000 4 g SENDC 
4 
000 GBS 
4 ; § : Put the rows and columns in the correct order. 
4 e 
0000 ? 4 smyent for, o}. Ne : ; initialize | 
arra e': 
491 “"INDEX, RIO, #1, maximum_sub(SP), #4, #0, R11 ; to fetch RUT) 
49¢ MOVL = r_sub_ (spreRiti: r_sub_i(SP§  ; fetch R(I) 
49 MOVL c_sub_O(SP)LRI1J, c_sub_i( SP) ; sete C(1) 
494 INDEX 7sub7i(SP), #1, maximum_sub(SP), #4, #0, R11 
495 ; to fetch loc(R(1)) 


ooo, a. 


BASSMAT_INV ; BASIC matrix invert 15*SEP=1984 23:44:44 VAX/VMS Macro V04-00 Pa 11 
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6° £38 MOVL loc _sub_O(SP)CR11], loc _sub_r_sub_i(SP) ; fetch loc(R(I)) 
49 CMPL Loe sub-r_sub_i(SPS, c_Sub_T(SP) 7 if loc(R(I)) = C(I) 
i on eG tnt yee 
; don't switc 
| $3 F 0 101$ MOVL #1, R11 initialize L 
0 1 * 
00 ; 4 : Switch 2 rows 
| 000 808 
$00 i § 10$: MOVL R9, RO 3; pointer to output array 
444 28 MOVL Loc sub_r_sub_ i (SP), R1 ; current row 
0 8 MOVL R11, R 3 current column 
4 509 FETCH ‘array_dtype’ 3 fetch A(loc(R(I)), L) 
0000 511 MOV‘ array_dtype' RO, save_element(SP) ; save it in temp 
000 1 MOVL R9, RO ; pointer to output arra 
0000 218 MOVL c_sub_i(SP), R1 ; current row = , 
0000 514 MOVL Ti, R2 3 current column 
44 a2 FETCH ‘array_dtype' 3: fetch AC(C(I), L) 
0000 517 IF IDN array_dtype, H 
0000 518 MOVL R9, i; pointer to output array 
0000 519 MOVL lLoc_sub_r_sub_i(SP), R5 ; current row 
44 259 at 1 R11, R6 3 current col 
0000 5 § “ITF IDN array_dtype, G 
0000 5 MOVL R9, R2 ; pointer to output array 
0000 524 MOVL loc_sub_r_sub_i(SP), R3 3 current row 
464 526 wy R11, R4 3; current col 
0000 527 “IF IDN array_dtype, D 
0000 528 MOVL R9, ; pointer to output array 
0000 529 MOVL lLoc_sub_r_sub_i(SP), R3 3; current row 
B68 239 wrt R11, R4 3 current col 
0000 532 MOVL R9, R1 3 pointer to output array 
0000 23 MOVL loc _sub_r_sub_i(SP), R2 3 current row 
0000 4 MOVL R11, R3 3 current col 
0000 535 ~ENDC 
ar 
000 538 HOV' array_dtype' RO, data(SP) 
$? 275 STORE array_dtype’ ; store data into output array 
00 41 MOV’ array dtype’ save_element(SP), RO ; get element from temp 
00 59 IF {oN ° array_dtype, ‘ . 
00 4 MOVL R9, ; pointer to output array 
4 44 MOVL C sub i(SP), R5 3 current row 
$? nov RT1, R6 3; current col 
13 “IF IDN array_dtype, G 
0 rf MOVL ° 3; pointer to output array 
0 4 MOVL c sub i(SP), R3 3; current row 
0 29 vat RT1, R4 3 current col 
$0 52 TIF ION array_dtype, D 


———————_—___—_—- 


| BASSMAT_INV ; BASIC matrix invert 15-SEP-1984 23:44:44 VAX/VMS Macro Vv04-00 Page 1 
| 1-014 BECLARAT IONS ra et 93:39:49 BASRTL.SRCJBASMATINV.MAR; 1 ° (3) 
0 23 MOVL R9, R2 ; pointer to output array 
4 MOVL C ~~ i(SP), R3 ; current row 
2? ati) RT1, R4 : current col 
000 25 MOVL R9, ; pointer to output array 
00 28 MOVL C a4 i(SP), R2 3; current row 
44 5 MOVL RT1, R3 3 current col 
000 60 -ENDC 
44 61 ENDC 
66 -ENDC 
0000 6 HOV! array dtype" RO, data(SP) 
4s rt: STO array_dtype' ; store data into output array 
0000 66 
0000 67 ;+ 
0000 68 ; voraerty AOBLEQ was used here, but the code grew too big and now the 
0000 69 ; destination is out of range. 
0000 70 ;- 
0000 571 
Babs 276 ACBL maximum_sub(SP), #1, R11, 10$ ; next L 
0000 $74 20$: INDEX c_sub_i(SP), #1, maximum_sub(SP), #4, #0, RO ; to get tag(C(1)) 
0000 75 INDEX loc _sib_r _sub_ i (SP), #i, “maximum, sublsP). #4, #0, RI 
0000 278 £9 ge tag(loc(R(1))) 
0000 7 MOVL tag_sub OtsPrEROd. sub Bret sup rpasP ptr ‘ cnet oc (R(I)))=tag(C(I)) 
0000 578 MOVL r_sub_itSP ag, su : SB )= ai) 
0000 579 INDEX  t&@g_sub “bcsby ER 3 oT. i Sna sub(S 
0000 580 Oo get Wecttagetoc(R(1)))) 
0000 581 INDEX er sub_i(SP), #1, maximum_ sub(SP), i, #0, 
0000 26 : get loc(R(I)) 
0000 58 MOVL  Loc_sub_0(SP)CR2], loc_sub _ocsprtRss 
0000 584 Loc (R(1))=Loc(tag(loc(R(1)))) 
0000 585 MOVL = Loc_sub_r_sub_ tape loc_sub _0(SP)ER 5 
0000 586 Loc (tag(loc(R(1))))=Loc(R(I)) 
0000 587 ACBW maximum_sub(SP), #1, R10, INVERT. *ROws. array_dtype' 
0000 588 7; next | 
0000 589 
944 90 ;+ 
000 91 ; Reinitialize the tag and loc vectors 
0000 38 3° 
4s y 
000 94 MOVL #1, R10 ; initialize | 
0000 95 50S: INDEX R16, #1, maximum_sub(SP), #4, #0, R11; to fetch Ith element 
9000 596 Rov. RIO, Log sub_0($P) (R11 ! initialize loc 
9 MOVL R10, tag_sub_O(SP)CR11 ; initialize tag 
i 4 38 AOBLEQ max imum_Sub(SP), R10, 50$ 3; next element 
000 600 ;+ 
44 g ; Put the columns in the correct order. 
6 ° 
op 604 MOVL #1, R10 ; initialize | 
? 5 INVERT “cole arra notype : 
$ INDEX R10 mex inua.s sub(SP), #4, #0, R11 to fetch C1) 
0 6 r_sub_ (spp tri -F Sub. {(sP$f fetch RUI) 
3 3 8 MOVL c-sub_O(SP)CR11), ¢-Sub “i(SP)  ; fetch C(I) 
0 6 INDEX c_sub_i(SP), #1, maximum_sub(SP), #4, #0, R11 


BASSMAT_INV 
1-014 
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£08 619 ; to fetch loc(C(I)) 
11 MOVL loc sub_0(SP)CR11J, loc_sub_c_sub_i(SP) ; fetch loc(C(1)) 
999 1¢ cHPL toc’ sub-c_sub_i (SP, r_Sub_7(SP) = if loc(C(I)) = RCI) 
4 gi BRW 20$ ; don't switch 
00 oF 102$:  MOVL #1, R11 ; initialize L 
000 18 
$000 18 : Switch 2 col 
3; Switc cols 
0900 319 ;= 
$009 3 ‘ 10$ MOVL R9, RO i t 
: : ; pointer to output arra 
0000 6 ¢ MOVL loc_sub_c_sub_i(SP), R2 3 Current coluan’ , 
0000 ? MOVL , RI 3; current row 
0000 4 FETCH ‘array _dtype' ;_fetch ACL, loc(C(1))) 
0000 ? é MOV’ array_dtype' RO, save_element(SP) ; save it in temp 
000 6 MOVL R9, RO ; pointer to output arra 
8008 628 MOVL r_sub_i(SP), R2 3 Srrons coluae” y 
000 06? MOVL RT1, Ri 3; current row 
B08 ° FETCH ‘array_dtype’ 3 fetch ACL, R(I1)) 
0000 o32 If IDN array_dtype, H 
BRR 63 MOVL R9, : pointer to output array 
000 634 MOVL loc_sub_c_sub_i(SP), R6 ; current col 
0000 635 MOVL R11, R5 3; current row 
44 636 LFF 
000 637 if IDN array_dtype, G ‘ 
0000 638 MOVL R9, R2 : 3; pointer to output array 
0000 639 MOVL lLoc_sub_c_sub_i(SP), R4 ; current col 
0000 640 MOVL R11, R3 3 current row 
0000 641 LFF 
0000 o¢6 IF IDN array_dtype, D 
0000 64 MOVL R9, R2 3; pointer to output array 
0000 644 MOVL loc_sub_c_sub_i(SP), R4 3 current column 
0000 645 MOVL R11, R35 3 current row 
0000 646 1FF 
O00 647 MOVL R9, RI j ; pointer to output array 
000 968 MOVL loc_sub_c_sub_i(SP), R3 ; current col 
8008 64 MOVL R11, R2 3; current row 
00 650 -ENDC 
0000 651 »ENDC 
000 026 -ENDC 
it o2 MOV’ array_dtype' RO, data(SP) 
0000 $28 STORE array_dtype' 3; store data into output array 
00 65 MOV'array_dtype' save_element(SP), RO ; get element from te 
0000 $39 If {oN " array_dtype, H ° e 
000 $28 MOVL ° ; pointer to output array 
4 65 MOVL r_sub_i(SP), R6 3; current col 
0 660 MOVL RT1, RS 3 current row 
8 38 661 LFF 
0 066 IF IDN array_dtype, G 
it 66 MOVL R9, ; pointer to output array 
664 MOVL r od i(SP), R4 ; current col 
444 665 MOVL RT1, RS 3 current row 
000 666 LFF 


13 
(3) 


BASSMAT_INV 
4-014 


cc 
| 


SIC matrix invert 
BECLARATION NS 
000 667 
800 Seo 
$00 690 
0000 671 
0000 66 
44 67 
000 674 
0000 675 
0000 676 
0000 677 
0000 678 
0000 67 
0000 680 
0000 681 
0000 ob¢ ; 
0000 68 
0000 684 ;- 
0000 685 
0000 686 
0000 687 
0000 688 20$: 
0000 689 
0000 690 
0000 691 
0000 69 
0000 69 
0000 694 
0000 695 
0000 696 
0000 697 
0000 698 
0000 699 
0000 700 
0000 701 
0000 70 
0000 70 
0000 704 
0000 705 
0000 706 
0000 707 
0000 708 
0000 709 
8008 710 ;+ 
000 711 ; Input 
0000 gle : RO 
0000 713 ; R10 
0000 714; R11 
0000 715; Out ut 
0000 716; 7 
a4 717 ; ne 
000 718; R 
0000 719 ;:- 
0000 720 
44 721 
000 7 ¢ 
0000 723 ;+ 


15-SEP-1984 $338 44:44 VAX/VMS Macro v04-00 Page 14 
6-SEP-1984 10:29:37 (CBASRTL.S RCIB BASMATINV.MAR; 1 (3) 

elf IDN array. Se D 

MOVL R9, R ; pointer to —e array 

MOVL r sub i(SP), 3; current colum 

nov RT1, R3 3: current row 

MOVL R9, RI i; pointer to output array 

MOVL r_sub_i(SP), R3 3 current col 

MOVL RT1, R2 3 current row 

-ENDC 

~ENDC 

eENDC 

HOV! array dtype' RO, data(SP) : 

$TO array_dtype' 3 store data into output array 


3s? 
; AOBLEQ will not work here because the destination is out of range. 


ACBL maximum_sub(SP), #1, R11, 108 ; next L 


INDEX er sub_i(SP), #1, maximum_sub(SP), #4, #0, RO 3 a gst tag(R(1)) 
INDEX (3c _sub_c¢c _sub_ i(SP), #1, “maximum. subisP). 0, R1 
gitocic : 


1))) 
MOVL  tag_sub Q¢SP) CROJ. tag su ube O<sP potri ' nine oc(C 1)))=tag(R(1)) 
MOVL c_sub_itSP) ag sub : iain )= ccI) 
INDEX tag_ sub “OcSPDER J, aT, nae sub ( R2 
Oo get “Tae tagttoccccny99) 


INDEX c_sub_i(SP), #1, maximum_ sub(SP), i, #0, 
: get loc(C(I1)) 
MOVL = Loc_sub_0(SP)CR2J, loc_sub _ocsprtRss 


t . eee loc (tag(loc(C(1)))) 
MOVL = Loc_sub_c_sub_i(SP), loc_sub .0¢SPDER 
- €tag( Loc (C(1))))= loc (C(1)) 
ACBW maximum_sub(SP), #1, R10, INVERT. “cous, array. _dtype' 
e ex 


RET : yes, finished 


arguments to subroutines 
pointer to witty | 
upper bound on loop 
pointer to ssliere” stack argument ‘ist 
from subroutine, always returned, only picked up on the 2nd call 
new pivot 
new pivot row 
new pivot column 


LOOP_K_‘array_dtype': 


f 
| 


| BASSMAT_INV ; BAS 
1-014 


t 


3 
z3 


5 


SoOOOCCCOCCOOOCOOOOOOOOCOOCOOOCOSOOOOoOOO Ae 
SOCCCOCOCOCOCOCSOOOOOOOOOOOOOoOSOoOSoO FO 


DPSS Be BB EB EAA 
OOONA US WN $$ O OONAULS WN OO OONOUS 


? 
? 
? 
? 
? 
0 ? 
00 ? 
00 7 
00 ? 
00 ? 
00 7 
0000 7 
0000 7 
0000 7 
0000 7 
0000 7? 
0000 761 
0000 Poe 
0000 6 
0000 764 
0000 765 
0000 766 
4 767 
00 768 
0000 769 
0000 770 
0000 771 
0000 77 
0000 77 
0000 774 
0000 775 
44 77 
000 (77 
0000 778 
0000 779 
0000 780 


ix invert 


4 ; Redefine the | 
3 necessary for F 


}- sores 2935 = 124 


oy Ae = 128 
dtype = 1 
class = 


str. 


START_K_LOOP ‘array_dtyp 
“INDE curfent 


Len 


54 
; Store 


1 
= 124 


SUBL2 


CLR*array_ dtype’ 


0 in ACR(K), 


| tetie dtype’ 


ROV array. dtype 


15=SEP=1984 23:44:44 

6-SEP-1 19be $3; :29:37 
touting synbots. 3 sinc 
H and STORE, which 


#56, SP 


e': 
current k (R11) #1, maximum sub(R11), 
r_sub_OTR11)CROJ, r_sub_k(RT1) ; 
R9, RO 
r_sub_k(R11), R1 
¢_sub_ i(R11), R2 
Bee dtype 


RO 
array_dtype, H 


r_sub_ k(R11), RS 
: “sub_i(R11), R6 


IDN array_dtype, G 
RO, R2 y_atyp 
r _Sub_ k(R11), a 

Cc “sub_ i(R11), 


RO, data(SP) 
array. yet 


AX/VMS Macro V04-00 
BASRTL.SRCIJBASMATINV.MAR; 1 


temp_pivot_ abs (SP) 


space for 2 pivots & row & col 
3; initialize new abs pivot 


store 


ce the stack will be changed. This is 
use them to access the stack. 


24 
3; Now store in temps elements that are invariant in inner loop 


; pointer to output array 
3; current row 
: —- column 


RO, a_sub_rkci(Rit)'s 


zero to 


pointer 
current 
current 


pointer 
current 
current 


: “store ACR(K), 


C(1)) so that computation can be made in J loop 


be stored 


to output array 
row 
col 


to output array 
row 
col 


scale the 0 


pointer 
current 
current 


pointer 
current 
current 


to output array 
row 
col 


to output array 
row 
col 


Page 


#4, #0, RO; to fetch R(K) 
R(K) temp 


h data from output array 
C(1)) temp 


store data into output array 


1 
( 


5 
3) 


dD 3 
| BASSMAT_INV ; BASIC matrix invert 15“SEP=1984 23:44:44 VAX/VMS Macro V04-00 Page 1 
1-014 BECLARATIONS 6-SEP-1984 $9:59:4 BASRTL.SRCJBASMATINV.MAR; 1 . (%) 
| 
781 ;+¢ 
| 009 7 ¢ ; Now loop sree the cols (J in algorithm) of row K that are greater than I 
4 4 ? ; Look for new pivot element at the same time. 
000 785 ° 
0000 7? § MOVL maximum _sub(R11), current_j(R11) ; initialize J 
000 7 CMPL 1 tea ahaa maximum _sub(R11) ; is I = max sub? 
0000 788 BNEQ 10$ i; no, continue 
0000 789 BRwW LOOP _J "ecrey etype" : yes. do loop J <= | 
444 790 10$: INDEX current 1iet J , maximum_sub(R11), #4, #0, RO; to fetch CJ) 
000 791 MOVL c_sub_OTR11)(ROJ, =(SP) ; current column 
4464 138 
000 793 ;+ 
0000 794 ; ACR(K), CCJ)) = ACR(K), CJ) ACR(I), CCJ)) © ACR(K), CCI)) 
0000 795 ;- 
0000 79 MOVL RRO 
° 3; pointer to output array 
0000 798 MOVL r_sub_i(R11), R1 3; current row 
0000 799 MOVL (SP), "R2 3; current column is on stack 
44 ane FETCH ‘array_dtype’ ; fetch data from output array 
3808 ong MUL ‘array_dtype'2 a_sub_rkci(R11), RO ; RO=A(R(I),CCJ)) #A(R(K),CCI)) 
0000 804 IF IDN array dtype, D . 
0000 805 DIVD2 scale(Ri1), RO : get rid of extra scale 
0000 806 CMPD scale(R11), #1 : 1f scale factor is 0 
0000 tt BEQL 15$ ; don’t integerize _ 
0000 08 JSB G*MTHSDINT_R4 i; otherwise, integerize 
C000 §8=—«._- 809 -ENDC 
0000 810 
0000 811 15$: MOVL (SP), R5 ; prepare for next fetch 
0000 aig MOV‘ array _dtype' RO, -(SP) 3 Save partial computation 
0000 = 81 MOVL . ; pointer to output array 
0000 814 MOVL r_sub_k(R11), R1 3 current row 
0000 815 MOVL R5, R 3; move saved current col 
i464 31§ FETCH ‘array_dtype’ : fetch data from output array 
0000 818 SUB'array_dtype'2 (SP)+, RO ; RO=A(R(K),C(J))-temp 
0000 819 
0000 820 ;+ 
0000 821 ; Now store the computed result in A(R(K), C(J)). If the computed result 
0000 B56 ; is larger than pivot, make this element the new pivot. 
0000 823 ;- 
$00 $58 IF IDN array_dtype, H 
000 826 MOVL (SP)+, R4 ; save col here for now 
000 H 7 LFF 
000 8 IF IDN array_dtype, G 
000 829 MOVL (SP)+, R4 ; put current col for store 
000 830 LFF 
0000 1 IF IDN array_dtype, D 
sit 3 tet (SP)+, R4 ; put current col tor store 
000 4 MOVL (SP)+, R3 ; put current col for store 
4 5 -ENDC 
00 § -ENDC 
000 83 -ENDC 


———__— J 
| 2 
BASSMAT_INV : BA ix i -SEP- 
| PARSE a eas] trix invert SEP=1 


35 


3 
9 MOV’ array _dtype' 
i BGEQ. 508” 


r~ 
bt 


MNEG' array_dtype' 


208: CMP’ array dtype' save_result(SP) 
Biss, S08” Bix ies 


OOoooooooooo 


RSP URE. se. See REA SB 


984 23:44:44 \VAX/VMS Macro v04-00 Page 17 
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m 
I 
| 
a 
0 r 
| 0 if MOV d Lt(SP) 
‘array_dtype' save_result 
000 845 MOV' array-dtype' RO, 
0 8 rk} MOVL current_k(R11), temp_pivi (SP) 
80 3 ts MOVL current_j(R11), temp_pivj (SP) 
000 49 30$: IF IDN array_dtype, H 
0000 880 MOVL «RG, RG eR 
0000 51 MOVL R9, RG 
0000 26 MOVL r_sub_k(R11), R5 
$000 3 Ife IDN d G 
. array_dtype, 
0000 885 Move RO, 4 
0000 56 MOVL r_sub_k(R11), R3 
0000 857 FF 
0000 858 olf IDN array_dtype, D 
0000 859 MOVL R9, 
0000 860 MOVL r_sub_k(R11), R3 
0000 861 FF 
0000 Hu MOVL R9, R1 
0000 86 MOVL r_sub_k(R11), R2 
0000 864 -ENDC 
0000 865 -ENDC 
0000 866 -ENDC 
0000 867 MOV’ array_dtype' RO, data(SP) 
0000 868 STORE array_dtype' 
0000 869 
0000 870 SUBL2 #1, current_j(R11) 
0000 871 CMPL current _j(RT1), current_i(R11) 
0000 are BLEQ LOOP_J_"array_dtype’ 
0000 87 BRW 10$ 
0000 74 
0000 2 3% 
0000 76 ; Now loop through the cols (J in algorithm) of 
0000 877 ; equal to I. Don't look for new pivot in this 
0000 878 ;- 
44 144 
000 80 LOOP_J_"array_dtype’ : 
0000 +t INDE current 1¢93)) a 
0000 Be MOVL  c_sub_0TR11)C(ROJ, =(SP) 
0000 88 
0000 HE i+ 
0000 85 ; ACR(K), C(J)) = ACR(K), CCJ)) = ACRCI), CCJ)) 
000 36 3° 
000 
000 8 MOVL R9, RO. 
000 9 MOVL r_sub_i(R11), R1 
000 90 MOVL (SP), R2 
st 91 FETCH ‘array_dtype’ 
00 3 ; 
000 9 MUL ‘array_dtype'2 a_sub_rkci(R11), 
000 94 


) 


RO, save_result(SP) ; move computed result 


uted i continue 


3 comp s pos. 
save_result(SP), save_result(SP) ; make neg result p 
, temp_pivot_abs(SP) ; is ele 


ment les 


yes, continue 
temp_pivot_abs(SP) ; no, make new a 


temp pivot (5?) ; few pivot 


3 new pivot row 
i new pivot col 


; move current col 
3 pointer to output array 
3; current row 


; pointer to output array 
3; current row 


pointer to output array 
current row 


pointer to output array 
3; current row 


3; store data into output array 


; decrement loop counter 
3 continue looping? 

3 no 

+ yes 


row K that are less than or 
area of the array. 


#1, maximum_sub(R11), #4, #0, RO; to fetch C(J) 


3; current column 
* ACR(K), C(1)) 


3 pointer to output array 

3; current row 

3; current column is on stack 

3; fetch data from output array 


RO ; RO=A(R(I),£ (J) #ACR(K) CCL) 


oR arenamecmeriucce . nemo tas 


ee 
| BASSMAT_INV ; BASIC _ matrix invert 15*SEP=1984 23:44:44 VAX/VMS Macro V04-00 Page 1 
| 1-016 BECLARATIONS 6-SEP-1984 $3:39:49 BASRTL.SRCIJBASMATINV.MAR; 1 . (3) 
0 95 IF IDN array _dtype, D ' 
| § 38 DIvD2 scale(R11), hy ” : get rid of extra scale 
| 0 9 CMPD scale(R11), #1 3 if scale factor is 0 
0 98 BEQL ; don't integerize 
000 99 JSB G*MTHSDINT_R4 ; otherwise, integerize 
000 00 ~ENDC 
| 000 902 158: MOVL (SPD, RS fetch 
: P i; prepare for next fetc 
000 308 MOV’ erra dtype’ RO, =(SP) : Seve partial computation 
Boop 904 MOVL ’ 3; pointer to output array 
000 905 MOVL r_sub_k(R11), R1 3; current row 
Bb 389 MOVL ° 3; move saved current col 
444 444 FETCH ‘array_dtype’ 3; fetch data from output array 
0000 909 SUB’ array_dtype'2 (SP)+, RO 3 RO=A(R(K),C(J))-tem 
0000 910 — 7 
444 911 3+ 
000 a 3; Now store the computed result in A(R(K), C(J)). 
0000 913 ;- 
0000 914 
0000 915 IF IDN array_dtype, H 
0000 aig MOVL (SP)+, R6 ; put current col for store 
0000 91 MOVL RJ, R 3 pointer to output array 
0000 918 MOVL r_sub_k(R11), R5 3; current row 
0000 919 LFF 
0000 ast IF IDN array_dtype, G 
0000 921 MOVL (SP)+, R4 ; put current col for store 
0000 9 ¢ MOVL R9, 3; pointer to output array 
0000 9 MOVL r_sub_k(R11), R3 ; current row 
0000 924 IFF 
0000 352 anv IDN array_dtype, D 
0000 926 MOVL (SP)+, R4 ; put current col for store 
0000 927 MOVL R9, R 3 pointer to output array 
0000 928 MOVL r_sub_k(R11), R3 ; current row 
0000 4 wIFF 
0000 930 MOVL (SP)+, R3 3; put current col for store 
0000 931 MOVL RI, R 3; pointer to output array 
0000 336 MOVL r_sub_k(R11), R2 3; current row 
0000 93 ~ENDC 
0000 934 -ENDC 
0000 935 -ENDC 
0000 936 MOV array_dtype' RO, data(SP) 
949 44 STORE array_dtype' 3: store data into output array 
$383 38 
000 940 ;+ . 
0000 941 ; SOBGTR will not work here because the destination is out of range. 
0000 Bee :- 
944 94 : 
000 944 DECL current_j (R11) 
0000 945 BLEQ 1038 , 
4444 208 BRW LOOP_J_‘array_dtype' : continue J loop 
$00 948 103$: ACBW R10, #1, current_k(R11), START_K_LOOP ,orrey stype" 
009 4 > continue K~ loop 
00 951 MOV‘ array_dtype’ temp_pivot(SP), R4 ; return new pivot 


_BASSMAT_INV ; BASIC matrix invert 15-SEP-19 744: AX/VMS Macro v04-00 Page 19 
wt BECLARAT IONS 6-SEP eats ri 93:56 93 EBASRTL. SRCIBASMATINV.MAR; 1 i 
68 926 MOVL (SP)+, Re ; return new pivot row 
95 MOVL (SP)+ 3 return new pivot column 

00 954 ADDL2 #48, gp ; pop off 2 pivot temps 
000 955 

44 928 i+ 

00 957 ; Restore symbols 

44 328 3° 

bo5 95 

000 960 value_desc = 64 

0000 961 data = 7 

0000 962 pointer = 68 

000 963 dtype = 6 

000 964 class = 6 

000 965 str_len = 64 

0000 96 

0000 96 RSB 3; return 

0000 968 

0000 969 ~ENDM 

0000 970 


> 
} 
| 
| 
| 
| 
| 
j 
| 
| 
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Ree -SBTTL BASSMAT_INV = Invert a matrix 
$ FUNCTIONAL DESCRIPTION: 


Invert the contents of and input matrix and put the result in a 
destination matrix. Signal an error if the upper and 

lower bounds (excluding 0) for rows and columns in input_matrix 

does not equal the oper and lower bounds (excluding 0) for rows 

and columns res oct ives in output matrix. 

An error will a 3° be signalled if either matrix does not 

have a DIMCT of 2. Copy the input_matrix to the output_matrix using 
BASSMAT_ASSIGN. The assign routine will redimension 

the output matrix to have a lower bound of 0 for both dimensions, 
and an upper bound for rows equal to the upper bound for rows for 
input_matrix, and an upper bound for columns equal to the upper bound 
for columns for input_matrix. Initialize all the necessary 

Looping information on the stack. To Susger’ different data types, 
divide the looping portion according to the data types. 


CALLING SEQUENCE: 

CALL BASSMAT_INVERT (input_matrix.rx.da, output_matrix.wx.da) 
INPUT PARAMETERS: 
997 input_matrix = 4 
IMPLICIT INPUTS: 

Scale from the callers frame to scale double precision. 
OUTPUT PARAMETERS: 

output_matrix = 8 
IMPLICIT OUTPUTS: 

NONE 


FUNCTION VALUE: 
COMPLETION CODES: 


NONE 
SIDE EFFECTS: 


This routine calls the matrix copy routine which calls 

the redimensioning routine and the array element 

fetch and store routines and therefore may signal any of their errors. 
It may also signal any of the errors Listed in the externals section. 
It may also cause the destination array to have different dimensions. 
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-ENTRY BASSMAT_INV, “M<R2,R3,R4,R5,R6,R7,RB,RI,RIO,R11,1V> 


MMIOOCOCOCOOCOOSOOOOCOOCOOCOSCSSOOCOOSSOCOOCOCOSOOOOOOOOOOOOOOOOOOOOOoOOoOO gs 


OOOOCOOSOOOCOOOOOOOOSOOOOOOOOOOOOOSOOOOOOOOOOOOOOOOOOOOOOOOOOOO > 


a td dd od 
COONAN WIN O ODNAU EWN — O ODNAUS WO Oo 


POMONONORONOPONONY 2 St OO oe 


SOoooooooooeoo 


SoSoOoooooooo 
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| BASSMAT_INV ; BASIC matrix invert 15-SEP-1984 23:44:44 VAX/VMS Macro V04-00 P 1 
bear’ BASSMAT_INV = Invert @ matrix B-SEP-1984 10:29:37 FBASRTL.eREIGASMATGAV.MaR;1 (2° 2) 
| 0 9; REGISTER USAGE 
| ? 3 RO = R&B destroyed by store routines 
3 place to store element of Ist array while ee be 2nd element 
§ 3 R10 pointer to dest matrix descriptor senceot for double in which 
0 3 case R10 is part of double value R9-R1 
3 : : R11 current value of inner subscript 
05 4089 :+ 
0 8 ; Put routine arguments into registers for ease of use. 
ib : If block 2 of array descriptor (multipliers) is not present then error. 
0 41° 
52 04 AC 00 0 4 MOVL input_matrix(AP), R2 - ptr to input array descr 
27 OA A2 = «=«(07-~SséE 0 rk BBC #DSCS0_ FL. BOUNDS, DSC$B_AFLAGS(RD)” ERR_ARG ONMAT 4 
a Ln beet 
resent in descriptor 
02 OB A2 91 0 B46 CMP DSCS$B_DIMCT(R2), #2 8 dimensional? “ 
12 OF 04 BNEQU ERR_MATDIMERR if not, error 
28 A220 A2~séO1 1 bee CMPL dsc$l_ul_2(R2), dsc$l_u2_2(R2) see if matrix to be inverted 


is square, since inversion 
will be done in output matrx 
and it will have lower bnds 
of 0, only check upper bnds 
; square matrix, continue 

else fall into error 


3% «13 BEQL _INIT_TWO_SUBS 


Bete Se Se Ge Se Se Se Se Ge 


ERR_ARRMUSSQU: 
00000000'8F DD PUSHL 
00000000'GF 01 FB 


#BASS$K_ARRMUSSQU 
CALLS #1, G*BASS$S$STOP 


0 
4 
é 
i Signal error, array to be 
9 

0 ERR_MATDIMERR: 

PUSHL 

4 

5 

6 

7 

8 

9 


inverted is not square 


00000000°8F ODD 
00000000°GF 01 FB 


#BASSK_MATDIMERR 
CALLS #1, G*BASSS$STOP 


Signal error, input matrix 
is not 2 dimensional 


et a a a ws a a a a a a ss 2 = ss a Ls a ds 


0 
0 
0 
0 
0 
0 
0 
0 
0 
0 
0 
6 
064 ERR_ARGDONMAT: 
00000000'8F ODD 0 PUSHL #BAS$K_ARGDONMAT ; signal error 
00000000'GF 01 FB 9 CALLS #1, G*BASS$STOP : block 2 or $ absent 
068 ERR_CANINVMAT: 
00000000'8F oD 8 PUSHL #BAS$K_CANINVMAT ; signal error, matrix 
00000000 ' GF 01 FB ; 0 9 CALLS #1, G*BAS$$STOP ; is singular 
C 3+ 
C i g ; There are 2 subscripts. Copy the input matrix to the output matrix so 
4C 4 ; that the inversion may be done in place. The copy will do the necessary 
4C 5 ; redimensioning of the output array. 
te ore 
4C 3 INIT_TWO_ SUBS: ; 
08 af DD 4C PUSHL output_matrix(AP) ; destination of copy 
5 DD 4F 0 PUSHL 3 3; source for copy 
00000000'GF 02 FB 3} CALLS #2, G*BASSMAT_ASSIGN ; copy to output matrix 
5 3+ 
if } ; Initialize 4 vectors to keep track of row and column permutations during 
5 5 ; the invert. The 4 vectors are interwoven so that addressing one vector 


——_—— 
a 

BASSMAT_INV ; BASIC matrix invert 15-SEP-1984 23:44: AX/VMS Macro Vv04-00 Pa 22 
kein BASSMA INV = Invert a matrix 6-SEP-1984 10:39:49 EBASRTL. SREIGASMATINV. MAR; 1 ” (4) 


3; won't be dependent on the Length of the other vectors. Note that the vectors 
; will put 4 times the width of the grrey of longwords on the stack. Perhaps 

; this should be done in heap storage. However, space for arrays is usually 

; allocated on the stack, and the 4n for the vectors is minor when compared to 
; the n**2 space used for the array for Large n. 


3¢ 
3; Algorithm now differs according to data types 


9 
9 
50 20A : 9 MOVL dsc$l_ul_2(R2), RO i; get # of rows and cols 
5 3 C 94 1$ PUSHL RO 3 nth element of row vector 
5 9 PUSHL RO 3 nth element of col vector 
5 0 9 PUSHL 0 ; nth element of tag vector 
é 8 9 PUSHL s 3 nth element of loc vector 
F5 9 SOBGTR RO, 1$ ; do for all elements of row 
067 9 ; and cols 
067 0 
£ 130) 3¢ | 
3 4 8 : Initialize remaining stack temporaries 
067 1104 ° 
5E O000005SC BF C2 0067 0 SUBL2 #92, SP 3 save space on stack for 
06E 0 3 temps, some may be hfloat 
06E 0 ; .also data and value_desc 
01 odd 00 0 PUSHL #1 : initialize piv 
01 D 00 0 PUSHL #1 : initialize piv 
7E C 00 CLRO -(SP) ; space for 2 Longword temps 
01 OD 0074 PUSHL #1 3 initialize current_i 
0 A2 076 PUSHL dsc$l_ul_2(R2) ; initialize upperbnd for loops 
50 OC AD 00 o MOVL SFSL_SAVE_FP(FP), RO : get caller's frame and 
00000000'°GF 16 4 JS G*BASSSSCALE_R1 i: get scale in RO&R 
28 AE 50 70 ; MOVD RO, scale(SPY 3 Save it for computations 
7 
7 
; 
7 SEPARATE _DTYPES: 
59 O08 AC 00 7 AOVL output_matrix(AP), R9 3; get pointer to output array 
58 59 00 MOVL 3; loca copy which or change 
05 06 02 A&B ef § 5$: CASEB oSt$B DTYPE(R8), MDSCSK_DTYPE_B, #<DSCSK_DTYPE_D - DSCS$K_DTYPE_B> 
0037' es: eWORD BYTE-2$ 3; code for byte dtype 
15AD° 5 -WORD WORD-2$ ; code for word dtype 
2B23' 7 »WORD  LONG-2$ ; code for long dtype 
002A' \] -WORD ERR_DATTYPERR-2$ 3 quad not supported 
409C' -WORD FLOAT-2$ ; code for float dtype 
5612° -WORD DOUBLE-2$ ; code for double dtype 


> 


G and h floating fall outside the range of the CASEB statement, so check 
for them separately. 


CHB —DSCSB_DTYPE(RE), MDSCSK_DTYPE. G 
BRY = GFLOAT 
DSC$B_DTYPE (RB), #DSCSK_DTYPE_H 


ee ce ce ec ee cc ec ce ce ee ec ee ee ee ee ee ee ee ee ee ee ee cee ee ee ee ee ee ee ee ee ee ee ae eed ed 
wa 
tad 
o 
=z 
wv 
wo 


PRO ODNOA MNES WIN S$ OOD NAUNE WIN @ OOODNOA UE WN OOD NOAUE WR O OONOAU EWN OOONO 
wo 


SODUIWAAAAAAHROS 


EP RWWAWIWINIWIWIWIWIRPPOPONONOPPOPOIY 2 SS 


———— 


ASSMAT_INV ; BASIC matrix invert 
itt = baSsmat_INY - Invert a matrix 
4078 «31 pat 1143 BRw 
QOB1 1144 
18 02 A8 91 QOB1 1145 4$ CMPB 
06 1 0B5 1128 BNEQ 
58 04 AB 00B7 114 MOVL 
D1 00BB 1148 BRB 
O0BD 1149 
QOBD 1150 ERR_DATTYPERR: 
00000000°8F DD O0BD 1151 PUSHL 
00000000'GF 01 FB O0C3 1152 CALLS 


15-SEP-1984 AX/VM o V04-00 

g-8EP 138 18; 39: 3 YOASRIL SBASMAT INV. MAR; 1 
TO_HFLOAT 

DSC$B pives (ne). #DSCSK_DTYPE_DSC 

ERR_DATTYPERR 

4(RB), 

5$ 

+ ad DATTYPERR ; Signal error, unsupported 


G*BAS$$STOP ; dtype in array desc 
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<- 


L 3 


rix invert =-SEP- 
6-SEP- 


is SS 4 


- Invert a matrix 

34 

: Input array is a byte array. 
BYTE: SBASSMAT_INVERT B 


Input array is a word array. 


= Se Ge ee 
i 


ORD:  $BASSMAT_INVERT W 


1984 10:09:37 EBASRTL. SRCIBASMATINV.MAR: 1 


Use the macro to generate code. 


Use the macro to generate code. 
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| $ateAT-tNY baSSAAt INV = Invert @ matrix BaSEb=1984 10:35:49 UBASRTC. SRESBaSRATINV.man:1 "29 7 
| a i Input array is a longword array. Use the macro to generate code 


LONG: $BASSMAT_INVERT L 
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BASSMAT_INV BASIC matrix invert 15-SEP-1984 23: 
1-014 10:29:37 BASRTL.SRCJBASMATINV.MAR; 1 (5) 


BASSMAT _INV = Invert a matrix 6-SEP-1984 
414F 931 -412C «1175 TO_HFLOAT: BRW HFLOAT 


| BASSMAT_INV 
14 


1 


B 4 
SIC matrix invert 15=SEP prion $3: 44:44 VAX/VMS Macro v04-00 
bassn SMAT 1 NY = Invert a matrix 6-SEP=19 :29:37 [BASRTL.SRCIBASMATINV.MAR; 1 
412F 1177 34+ 
a : 1183 ; Sourcel array is a floating array. Use the macro to generate code 
4120F 1180 ° 
412F 1181 FLOAT: SBASSMAT_INVERT F 
56A5 1182 
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BASSMAT_INV BASIC matrix invert SEP=19 4 YVAK/VMS Macro v04-00 Page 28 
1-014 BASSMAT_INV - Invert a matrix irae tf 93:33 97 BASRTL. SRE CBA BASMATINV.MAR; 1 ’ (5) 
6A5 1184 i+ 
7 1 5 : Sourcel array is a double array. Use the macro to generate code 
6A5 11 $? 
6A5 1188 DOUBLE: SBASSMAT_INVERT D 
6C67 1189 
6(67 1190 ;+ 
6C67 1191 ; Input array is a gfloat array. Use the macro to generate code. 
6(67 1138 it 
6C67 119 
6C67 1194 GFLOAT: SBASSMAT_INVERT G 
827E 1195 
B27E 1196 ¥* 
827E 1197 ; Input array is an hfloat array. Use the macro to generate code. 
gcre 1198 ;- 
B27E 1199 
gre 1200 HFLOAT: SBASSMAT_INVERT H 
9898 1201 
9898 1202 - END 


_— CCS 
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Pa 1984 19:59:49 LBASRTL. SRE JBASHAT GV .MAR: 1 ° (5) 
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Symbol Fable BASRTL.SRCJBASMATINV.MAR; 1 
MAXIMUM 9 = 00000000 
MIHSDINT R eererene x 00 
OUTPUT NARTRIX = 000 of 
Pivl $ 1 
PIVJ = 0014 

Pivot = 000 3 H 
R_SUB_9 = 000 bg 
R-SUB"1 = 44 f 
R- nue K = 0000005 

SK vE ELEMENT = 444 4 

SAV r+ E-RESULT . + 0028 

SEPARATE_DTYPES $000 ; R 03 

SF$L_SAVE_FP = 44 44 44g 

START kK -LOOP_B Q000E61 R 03 

START_K_LOOP_D Beppeeee me 8 

START_K-LOOP"F OO04E CG R 0 
START_K_LOOP_G 00007A65 R 03 

START_K_LOOP_H 00009076 R 03 
START_K_LOOP_L 0000394D R 03 
START K ~LOOP~ Ww 00002307 R 03 

TAG_S0B-0 = 0000006C 
TEMP 00000000 R 02 

TEMP_PIVI = 00000000 

a _PIVJ = 00000004 

TEMP_PIVOT = 00000008 
TEMP pivot ABS = 00000018 
TO_HFLO 0000412C R 03 

00001640 R 03 
toes ea wwe ene nw acaena + 
: Psect synopsis ! 
PSECT name Allocation PSECT No. Attributes 
. " ( on P R N S LCL NOSHR NOEXE NORD NOWRT NOVEC BYTE 
i038 gangooo} <0} Bh «3-3 rte Use fON ABs EEL RGson exe "np “WRT MOVEE BYTE 
“BASSCODE 00009898 (39064.) $8 ( $°} PIC USR CON REL LCL SHR EXE RD NOWRT NOVEC LONG 
geome eeeceeeeeeeeeecoeseceeoes 
: ; Performance indicators ! 

Phase Page faults CPU Time Elapsed Time 
Initialization 29 0:00:00.08 00:00:00.53 
Command processing i ae 0:00: 00:09:18: 34 

ass 00:59. 2:02:13. 

pyabo} table sort ave 3: 8:98. . a roa 

Symbol table output 19 0:00:00.13 00:00: 0:28 

pooce exeevets Gneees 6 €8:80:89:0 89:00:90-00 
Assembler run totals 2426 O18, 0:02; 1°76 


_ EE eee... SS 


YAX/VMS Macro v04-00 Page 
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5 
VAK=11 Reere Run Statistics 6- 


mw 
we 
- 


vorking “tis Limit was 1200 p 
ascot bytes (830 pages) of virtusl memory were used to buffer the intermediate £559 
There vere 0 pages of symbol table po at Locator to hold 297 non-local and 12 local symbols. 
1202 source Lines were read in Pass producin 4 object records in Pass 2. 
69 pages of virtual memory were used to define 11 macros. 


Feeeeeeeooeoocooeecoesooeeoeen> 


! Macro Library statistics ! 


pmo nm aman rom n rawr ancora es eeanae + 


Macro Library name Macros defined 
“B52 28DUACE: feASRTL OBJ JBASRTL.MLB;1 
55$DUA SYSLIBISTARLET. MLB; 
Torre (all Libraries) 


493 GETS were required to define 7 macros. 
There were no errors, warnings or information messages. 
MACRO/ENABLE=SUPPRESSION/D1 SABLE=(GLOBAL , TRACEBACK) /LIS=LIS$:BASMATINV/OBJ=0BJ$:BASMATINV MSRC$:BASMATINV/UPDATE=(ENH$:BASMATINV) +L I 


—— 
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PROPRIETARY 
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